home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch8 / Stocks2.frm (.txt) < prev    next >
Visual Basic Form  |  1999-05-28  |  7KB  |  201 lines
  1. VERSION 5.00
  2. Begin VB.Form frmStocks2 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Stocks2"
  5.    ClientHeight    =   4140
  6.    ClientLeft      =   1305
  7.    ClientTop       =   810
  8.    ClientWidth     =   6870
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    PaletteMode     =   1  'UseZOrder
  13.    ScaleHeight     =   276
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   458
  16.    Begin VB.TextBox txtFramesPerSecond 
  17.       Height          =   285
  18.       Left            =   1440
  19.       TabIndex        =   4
  20.       Text            =   "20"
  21.       Top             =   3840
  22.       Width           =   375
  23.    End
  24.    Begin VB.TextBox txtNumStocks 
  25.       Height          =   285
  26.       Left            =   1440
  27.       TabIndex        =   3
  28.       Text            =   "5"
  29.       Top             =   3480
  30.       Width           =   375
  31.    End
  32.    Begin VB.CommandButton cmdStart 
  33.       Caption         =   "Start"
  34.       Default         =   -1  'True
  35.       Height          =   495
  36.       Left            =   2160
  37.       TabIndex        =   1
  38.       Top             =   3540
  39.       Width           =   855
  40.    End
  41.    Begin VB.PictureBox picCourt 
  42.       AutoRedraw      =   -1  'True
  43.       Height          =   3375
  44.       Left            =   0
  45.       ScaleHeight     =   221
  46.       ScaleMode       =   3  'Pixel
  47.       ScaleWidth      =   453
  48.       TabIndex        =   0
  49.       Top             =   0
  50.       Width           =   6855
  51.    End
  52.    Begin VB.Label Label1 
  53.       Caption         =   "Frames per second:"
  54.       Height          =   255
  55.       Index           =   0
  56.       Left            =   0
  57.       TabIndex        =   5
  58.       Top             =   3840
  59.       Width           =   1455
  60.    End
  61.    Begin VB.Label Label1 
  62.       Caption         =   "Number of stocks:"
  63.       Height          =   255
  64.       Index           =   1
  65.       Left            =   0
  66.       TabIndex        =   2
  67.       Top             =   3480
  68.       Width           =   1455
  69.    End
  70. Attribute VB_Name = "frmStocks2"
  71. Attribute VB_GlobalNameSpace = False
  72. Attribute VB_Creatable = False
  73. Attribute VB_PredeclaredId = True
  74. Attribute VB_Exposed = False
  75. Option Explicit
  76. Private NumStocks As Integer
  77. Private StockValue() As Integer
  78. Private StockTrend() As Integer
  79. Private CourtWid As Single
  80. Private CourtHgt As Single
  81. Private BigValue As Single
  82. Private SmallValue As Single
  83. Private Playing As Boolean
  84. Private NumPlayed As Long
  85. ' Generate some random data.
  86. Private Sub InitData()
  87. Dim stock As Integer
  88.     ' See how many stocks there should be.
  89.     If Not IsNumeric(txtNumStocks.Text) Then _
  90.         txtNumStocks.Text = "10"
  91.     NumStocks = CInt(txtNumStocks.Text)
  92.     ReDim StockValue(1 To NumStocks)
  93.     ReDim StockTrend(1 To NumStocks)
  94.     ' Set the initial stock data.
  95.     For stock = 1 To NumStocks
  96.         StockValue(stock) = Int(CourtHgt * 0.3 + Rnd * CourtHgt * 0.4)
  97.         StockTrend(stock) = Int(Rnd * 6 - 3)
  98.     Next stock
  99. End Sub
  100. ' Return a new stock value for this stock.
  101. Private Function NewStockValue(ByVal stock_number As Integer) As Integer
  102. Dim new_value As Integer
  103.     ' Set the new value.
  104.     new_value = StockValue(stock_number) + StockTrend(stock_number)
  105.     ' Update the trend value.
  106.     If new_value > BigValue Then
  107.         StockTrend(stock_number) = StockTrend(stock_number) + Int(Rnd * 5 - 3)
  108.     ElseIf new_value < SmallValue Then
  109.         StockTrend(stock_number) = StockTrend(stock_number) + Int(Rnd * 5 - 1)
  110.     Else
  111.         StockTrend(stock_number) = StockTrend(stock_number) + Int(Rnd * 5 - 2)
  112.     End If
  113.     ' Keep the trend under control.
  114.     If StockTrend(stock_number) > 10 Then StockTrend(stock_number) = 10
  115.     If StockTrend(stock_number) < -10 Then StockTrend(stock_number) = -10
  116.     NewStockValue = new_value
  117. End Function
  118. ' Start the animation.
  119. Private Sub cmdStart_Click()
  120.     If Playing Then
  121.         Playing = False
  122.         cmdStart.Caption = "Stopped"
  123.         cmdStart.Enabled = False
  124.     Else
  125.         cmdStart.Caption = "Stop"
  126.         Playing = True
  127.         InitData
  128.         PlayData
  129.         Playing = False
  130.         cmdStart.Caption = "Start"
  131.         cmdStart.Enabled = True
  132.     End If
  133. End Sub
  134. ' Play the animation.
  135. Private Sub PlayData()
  136. Dim ms_per_frame As Long
  137. Dim start_time As Single
  138. Dim stop_time As Single
  139.     ' See how fast we should go.
  140.     If Not IsNumeric(txtFramesPerSecond.Text) Then _
  141.         txtFramesPerSecond.Text = "10"
  142.     ms_per_frame = 1000 \ CLng(txtFramesPerSecond.Text)
  143.     ' Clear the drawing area.
  144.     picCourt.Line (0, 0)-(CourtWid, CourtHgt), picCourt.BackColor, BF
  145.     picCourt.Picture = picCourt.Image
  146.     ' Start the animation.
  147.     NumPlayed = 0
  148.     start_time = Timer
  149.     PlayImages ms_per_frame
  150.     ' Display results.
  151.     stop_time = Timer
  152.     MsgBox "Displayed" & Str$(NumPlayed) & _
  153.         " frames in " & _
  154.         Format$(stop_time - start_time, "0.00") & _
  155.         " seconds (" & _
  156.         Format$(NumPlayed / (stop_time - start_time), "0.00") & _
  157.         " FPS)."
  158. End Sub
  159. ' Play the animation.
  160. Private Sub PlayImages(ByVal ms_per_frame As Long)
  161. Dim stock As Integer
  162. Dim next_time As Long
  163. Dim new_value As Integer
  164.     ' Get the current time.
  165.     next_time = GetTickCount()
  166.     ' Start the animation.
  167.     Do While Playing
  168.         NumPlayed = NumPlayed + 1
  169.         ' Move the background 5 pixels left.
  170.         picCourt.PaintPicture picCourt.Picture, _
  171.             0, 0, CourtWid - 5, CourtHgt, _
  172.             5, 0, CourtWid - 5, CourtHgt
  173.         ' Clear the area for the new data.
  174.         picCourt.Line (CourtWid - 5, 0)-Step(5, CourtHgt), picCourt.BackColor, BF
  175.         ' Draw the new stock data.
  176.         For stock = 1 To NumStocks
  177.             ' Get the stock's new value.
  178.             new_value = NewStockValue(stock)
  179.             ' Draw the new segment.
  180.             picCourt.Line (CourtWid - 5, StockValue(stock))-(CourtWid, new_value), QBColor(stock Mod 15)
  181.             ' Update the saved data.
  182.             StockValue(stock) = new_value
  183.         Next stock
  184.         picCourt.Picture = picCourt.Image
  185.         ' Wait until it's time for the next frame.
  186.         next_time = next_time + ms_per_frame
  187.         WaitTill next_time
  188.         If Not Playing Then Exit Do
  189.     Loop
  190. End Sub
  191. Private Sub Form_Load()
  192.     Randomize
  193.     ' Get the drawing area size.
  194.     CourtWid = picCourt.ScaleWidth
  195.     CourtHgt = picCourt.ScaleHeight
  196.     BigValue = CourtHgt * 0.7
  197.     SmallValue = CourtHgt * 0.3
  198.     ' Make a permanent background image.
  199.     picCourt.Picture = picCourt.Image
  200. End Sub
  201.